VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "CollectionClass"
Attribute VB_Creatable = False
Attribute VB_Exposed = False

Private m_Collection As New Collection
Public Sub A_ReadMe()
'This template is designed for use with the RAD-Copy Buddy.
'
'Purpose:   This template provides all procedures required to
'           support a type-enforced collection of a class.
'
'Usage:     1) Change {{ClassName}} to the name of the class to
'              be collected.
'           2) RAD-Copy all Declarations and procedures to
'              a new VB Class in the same project as the
'              collected class.
'
'Tags:
'{{ClassName}}
End Sub

Public Function Add(Optional vKey As Variant, _
                    Optional vBefore As Variant, _
                    Optional vAfter As Variant) As ClassName
'** Create a new object/variable of class ClassName
'** add it to the collection and return a reference
'** to it.  Use Key if available.
'
    Dim gClassName As ClassName
'
    Set gClassName = New ClassName
'
    If IsMissing(vKey) Then
        If Not IsMissing(vBefore) Then
            m_Collection.Add Item:=gClassName, Before:=vBefore
        ElseIf Not IsMissing(vAfter) Then
            m_Collection.Add Item:=gClassName, After:=vAfter
        Else
            m_Collection.Add Item:=gClassName
        End If
    Else
        If Not IsMissing(vBefore) Then
            m_Collection.Add Item:=gClassName, Key:=vKey, Before:=vBefore
        ElseIf Not IsMissing(vAfter) Then
            m_Collection.Add Item:=gClassName, Key:=vKey, After:=vAfter
        Else
            m_Collection.Add Item:=gClassName, Key:=vKey
        End If
    End If
'
    Set Add = gClassName
    Exit Function
'
End Function


Public Sub Remove(vIndex As Variant)
'
    m_Collection.Remove vIndex
    Exit Sub
'
End Sub


Public Function ClassName(vIndex As Variant) As ClassName
'
    Set ClassName = m_Collection(vIndex)
    Exit Function
'
End Function


Public Function Count() As Long
'
    Count = m_Collection.Count
    Exit Function
'
End Function
Public Sub ChangeKey(gClassName As ClassName, NewKey As String)
'** Loop thru all ClassName objects in the collection
'** to find supplied object.  Remove and re-add with
'** new key.
'
    Dim nIndex As Integer
    Dim gColObj As ClassName
'
    nIndex = 1
    For Each gColObj In m_Collection
'
        If gClassName Is gColObj Then
            m_Collection.Remove nIndex
            m_Collection.Add Item:=gClassName, Key:=NewKey
            Exit Sub
        End If
'
        nIndex = nIndex + 1
    Next
    Exit Sub
'
End Sub


